home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 7
/
FM Towns Free Software Collection 7.iso
/
data
/
happysrc
/
pcexpres.c
< prev
next >
Wrap
Text File
|
1993-11-30
|
36KB
|
872 lines
/************************************************************/
/* */
/* *** HAPPy Pascal Compiler *** */
/* 式のコンパイル処理 */
/* void expression(Set fsys) ; */
/* */
/* Copyright (c) H.Asano 1992 */
/* */
/************************************************************/
#define EXTERN extern
#include "pascomp.h"
#include "pcpcd.h"
extern void gen0(enum pcdmnc) ;
extern void gen1(enum pcdmnc,int) ;
extern void gen0t(enum pcdmnc,stp*) ;
extern void gen1t(enum pcdmnc,stp*,int) ;
extern void gen2t(enum pcdmnc,stp*,int,int) ;
extern void gencompare(enum pcdmnc,char,int) ;
extern void genldc(char,long) ;
extern void genixa(long,int) ;
extern void genchk(stp*,int,long,long) ;
extern void convertint(stp*) ;
extern void load(void) ;
extern void loadaddress(void) ;
extern ctp *searchsection(ctp*) ;
extern ctp *searchid(Set) ;
extern void insymbol(void) ;
extern void pcerr(int,char*);
extern char *inttoch(long) ;
extern void skip(Set) ;
extern boolean string(stp*) ;
extern boolean compatible(stp*,stp*) ;
extern void getbounds(stp*,long*,long*) ;
extern int align(stp*,int) ;
extern Set *mkset(Set*,int,...) ;
extern Set *orset(Set*,Set*) ;
extern void call(Set,ctp*) ;
extern void *Malloc(int) ;
static void array(Set) ;
static void recordmember(void) ;
static void ptr(void) ;
static void factident(Set) ;
static void factconst(Set) ;
static void factlparent(Set) ;
static void factnot(Set) ;
static void factset(Set) ;
static void factset2(Set,stp*,boolean*) ;
static void factnil(void) ;
static void simpleexpression(Set) ;
static void plusminusope(attr,enum operator) ;
static void orope(attr) ;
static void mulope(attr) ;
static void rdivope(attr) ;
static void inope(attr) ;
static void relope(attr,enum operator) ;
static void cnvfloat(attr*) ;
/*******************************************/
/* expression() : 式のコンパイル処理メイン */
/*******************************************/
void expression(Set fsys)
{
stp in_set ; /* in演算子の処理のために必要 */
attr lattr ;
enum operator lop ;
Set ws ;
ws = fsys ;
addset(ws,relop) ;
simpleexpression(ws) ;
if(sy == relop) { /* 関係演算子の時 */
if(gattr.typtr)
if(gattr.typtr->form <= power) /* スカラ、範囲型、集合型の時 */
load() ; /* load命令 */
else loadaddress() ; /* それ以外は間接参照 */
lattr = gattr ; /* 今の式の属性を退避 */
lop = op ; /* 今の演算子を退避 */
if(lop == inop) /* in の時 integerでなければ */
if(gattr.typtr && (gattr.typtr->form == scalar) &&
(gattr.typtr != realptr)) /* inの前の式が順序型の時 */
convertint(gattr.typtr) ; /* 必要ならord命令生成 */
insymbol() ;
simpleexpression(fsys) ; /* 関係演算子の次の単純式の処理*/
if(gattr.typtr)
if(gattr.typtr->form <= power) /* スカラ、範囲型、集合型の時 */
load() ; /* load命令 */
else loadaddress() ; /* それ以外は間接参照 */
if((lattr.typtr) && (gattr.typtr))
if(lop == inop) inope(lattr) ; /* in 演算子処理 */
else {
if(lattr.typtr != gattr.typtr)
cnvfloat(&lattr) ; /* realへの変換処理 */
if(compatible(lattr.typtr,gattr.typtr)) /* 両方の型が同じ */
relope(lattr,lop) ; /* 関係演算子の処理 */
else pcerr(143,"") ; /* 演算子の両端の型が不一致 */
}
gattr.typtr = boolptr ;
gattr.kind = expr ; /* これ以降論理型の式とする */
}
}
/**************************************/
/* inope() : in 演算子処理 */
/**************************************/
static void inope(attr fattr)
{
if(gattr.typtr->form == power) /* 今の型が集合型 */
if(compatible(fattr.typtr,gattr.typtr->sf.pw.elset))
/* 底基の型と等しいか */
gen0(iINN) ; /* inn命令を生成 */
else {
pcerr(143,"") ; /* 演算子の両端の型が不一致*/
gattr.typtr = nil ;
}
else {
pcerr(130,"") ; /* 式は集合型でない */
gattr.typtr = nil ;
}
}
/*****************************************/
/* relope() : in 以外の関係演算子処理 */
/* = < > <> <= >= */
/*****************************************/
static void relope(attr fattr,enum operator fop)
{
int lsize ; /* 比較する大きさ */
char typind ; /* 比較命令の型 */
lsize = fattr.typtr->size ; /* その型の大きさ */
switch(fattr.typtr->form) { /* 型で振り分ける */
case scalar : /* スカラー */
if(fattr.typtr == realptr) typind = 'r' ; /* real */
else if(fattr.typtr == boolptr) typind = 'b' ; /* boolean */
else if(fattr.typtr == charptr) typind = 'c' ; /* char */
else typind = 'i' ; /* integer/列挙型*/
break ;
case pointer : /* ポインタ型 */
if((fop != eqop) && (fop != neop)) /* = <> 以外 */
pcerr(131,"") ; /* 等しいかどうかの判定しか駄目*/
typind = 'a' ;
break ;
case power : /* 集合型 */
if((fop == ltop) || (fop == gtop)) /* < > の時 */
pcerr(132,"") ; /* 完全包含の判定は駄目 */
typind = 's' ;
break ;
case arrays : /* 配列型 */
if(! string(fattr.typtr)) /* 文字列でない時 */
pcerr(134,"") ; /* 演算対象の型に誤り */
typind = 'm' ;
break ;
case records : /* レコード型 */
pcerr(134,"") ; /* レコード型は駄目 */
typind = 'm' ;
break ;
case files : /* ファイル型 */
pcerr(133,"") ; /* ファイルの比較は駄目 */
typind = 'f' ;
}
switch(fop) { /* 演算子で生成命令を区別 */
case ltop : gencompare(iLES,typind,lsize) ; /* < les命令 */
break ;
case leop : gencompare(iLEQ,typind,lsize) ; /* <= leq命令 */
break ;
case gtop : gencompare(iGRT,typind,lsize) ; /* > grt命令 */
break ;
case geop : gencompare(iGEQ,typind,lsize) ; /* >= geq命令 */
break ;
case neop : gencompare(iNEQ,typind,lsize) ; /* <> neq命令 */
break ;
case eqop : gencompare(iEQU,typind,lsize) ; /* = equ命令 */
}
}
/**************************************/
/* cnvfloat() : realへの変換処理 */
/**************************************/
static void cnvfloat(attr *fattr)
{
if((*fattr).typtr == intptr) { /* 前の式だけがinteger */
gen0(iFLO) ; /* 前の式を realに変換 */
(*fattr).typtr = realptr ;
}
else if(gattr.typtr == intptr) { /* 今の式だけがinteger */
gen0(iFLT) ; /* 今の式をrealに変換 */
gattr.typtr = realptr ;
}
}
/***************************************/
/* selector() : 変数の属性を選択する */
/* α[・・・] : 配列変数 */
/* α^ : ポインタ変数 */
/* α. : レコード変数 */
/***************************************/
void selector(Set fsys, ctp *fcp)
{
Set ws ;
gattr.typtr = fcp->idtype ; /* 型を設定 */
gattr.kind = varbl ; /* 種類は 変数 */
switch(fcp->klass) { /* 変数の型で振り分ける */
case vars : /*[変数] */
if(fcp->n.v.vkind == actual) { /* 実変数 */
gattr.access = drct ;
gattr.vlevel = fcp->n.v.vlev ;
gattr.dplmt = fcp->n.v.vaddr;
}
else { /* formal (変数引数) */
gen2t(iLOD,nilptr,level-fcp->n.v.vlev,fcp->n.v.vaddr) ;
gattr.access = indrct ;
gattr.idplmt = 0 ;
gattr.vlevel = fcp->n.v.vlev ; /* ファイルが変数引数の時の */
gattr.dplmt = fcp->n.v.vaddr; /* ために退避しておく */
} /* 本当はこのやり方は違反です */
break ;
case field : /* レコードのフィールド */
/* with文配下しかこないはず */
if(display[disx].occur == crec){/* 固定フィールドの時 */
gattr.access = drct ;
gattr.vlevel = display[disx].clev ;
gattr.dplmt = display[disx].cdspl+ fcp->n.fldaddr ;
}
else { /* vrec(可変フィールドの時) */
if(level == 1) /* 大域変数 */
gen1t(iLDO,nilptr,display[top].vdspl) ; /* ldo命令 */
else gen2t(iLOD,nilptr,0,display[top].vdspl) ; /* lod命令 */
gattr.access = indrct ;
gattr.idplmt = fcp->n.fldaddr ;
}
break;
case func : /* 関数 */
gattr.access = drct ;
gattr.vlevel = fcp->n.pf.sd.d.pflev + 1 ;
gattr.dplmt = 0 ;
}
ws = selectsys ;
orset(&ws,&fsys) ;
if(! inset(ws,sy)) {
pcerr(59,"") ; /* 変数に誤りがある */
skip(ws) ; /* fsys+selectsysまで読み飛ばし*/
}
while(inset(selectsys,sy)) { /* [ . ^ の間処理する */
if(sy == lbrack) /* [ の時 */
array(fsys) ; /* 配列の処理 */
else if(sy == period) /* . の時 */
recordmember() ; /* レコードの各要素の処理 */
else /* ^ の時 */
ptr() ; /* ポインタの処理 */
if(! inset(ws,sy)) {
pcerr(6,"") ; /* 不当な記号が現れた */
skip(ws) ;
}
}
}
/*****************************************/
/* recordmember() : レコードの要素の処理 */
/*****************************************/
static void recordmember(void)
{
ctp *lcp ;
if(gattr.typtr)
if(gattr.typtr->form != records) {
pcerr(140,"") ; /* 変数の型がレコード型でない */
gattr.typtr = nil ; /* 今後のエラー防止のためnilにする*/
}
insymbol() ; /* 次のsymbol */
if(sy == ident) { /* 名前 */
if(gattr.typtr) { /* レコードの要素から名前を探す*/
lcp = searchsection(gattr.typtr->sf.re.fstfld) ;
if(!lcp) { /* 名前がない時 */
pcerr(152,id) ; /* レコードの欄ではない */
gattr.typtr = nil ; /* 今後のエラー防止のためnilにする*/
}
else { /* 名前がレコードの欄の時 */
gattr.typtr = lcp->idtype ; /* 名前の型 */
if(gattr.access==drct) /* 直接参照の時 */
gattr.dplmt += lcp->n.fldaddr ;
else /* 間接参照の時(indrct) */
gattr.idplmt += lcp->n.fldaddr ;
}
} /* end (typtr != nil) */
insymbol() ; /* 名前の次を読み込む */
}
else pcerr(2,"") ; /* 名前がない */
}
/*****************************************/
/* array() : 配列の処理 */
/*****************************************/
static void array(Set fsys)
{
attr lattr ; /* 1つ前の属性 */
long lmin,lmax ;
int lsize ;
Set ws ;
do { /* 多次元配列のための繰り返し */
lattr = gattr ;
if(lattr.typtr)
if(lattr.typtr->form != arrays) {
pcerr(138,"") ; /* 変数の型は配列でない */
lattr.typtr = nil ;
gattr.typtr = nil ; /* loadaddressをさせない */
}
loadaddress() ;
insymbol() ;
mkset(&ws, comma,rbrack, -1) ;
orset(&ws, &fsys) ;
expression(ws) ; /* 添え字の式の処理 */
load() ;
if(gattr.typtr)
if(gattr.typtr->form != scalar)
pcerr(113,"") ; /* 添え字の型はスカラか範囲型 */
else
convertint(gattr.typtr) ; /* 必要ならord命令生成 */
if(lattr.typtr) {
if(compatible(lattr.typtr->sf.ar.inxtype,
gattr.typtr)) { /* 添え字の型と等しい */
if(lattr.typtr->sf.ar.inxtype) {
getbounds(lattr.typtr->sf.ar.inxtype,&lmin,&lmax);
if(debug) genchk(intptr,1,lmin,lmax) ; /* chk命令生成 */
}
}
else pcerr(139,"") ; /* 添え字の型が宣言と一致しない*/
gattr.typtr = lattr.typtr->sf.ar.aeltype ; /* 要素の型 */
gattr.kind = varbl ;
gattr.access = indrct ;
gattr.idplmt = 0 ;
if(gattr.typtr) {
lsize = gattr.typtr->size ;
lsize = align(gattr.typtr,lsize) ; /* 境界合わせ */
genixa(lmin,lsize) ; /* lxa命令の生成 */
}
}
} while(sy == comma) ;
if(sy == rbrack) insymbol() ;
else pcerr(12,"") ; /* ] がない */
}
/*****************************************/
/* ptr() : ポインタ参照の処理 */
/*****************************************/
static void ptr(void)
{
if(gattr.typtr)
if(gattr.typtr->form == pointer) { /* ポインタ型の時 */
load() ;
gattr.typtr = gattr.typtr->sf.pt.eltype ; /* 指し示すものの型 */
if(debug) /* デバッグコンパイルの時 */
gen0(iCKA) ; /* CKA命令 */
gattr.kind = varbl ;
gattr.access = indrct ; /* 間接参照 */
gattr.idplmt = 0 ;
}
else if(gattr.typtr->form == files) /* ファイル型の時 */
gattr.typtr = gattr.typtr->sf.fi.filtype ; /* ファイルの基の型 */
else pcerr(141,"") ; /* ファイル型か指標型でない */
insymbol() ;
}
/**************************************/
/* factor() : 式の因子(factor)の処理 */
/**************************************/
static void factor(Set fsys)
{
Set ws ;
if(! inset(facbegsys,sy)) {
pcerr(58,"") ; /* 項に誤りがある */
ws = fsys ;
orset(&ws, &facbegsys) ;
skip(ws) ; /* fsys+factbegsysまで読み飛ばし*/
gattr.typtr = nil ;
}
while(inset(facbegsys,sy)) {
switch(sy) {
case ident : /* 名前の時 */
factident(fsys) ;
break ;
case intconst : /* 整数定数 */
case realconst : /* 実数定数 */
case stringconst : /* 文字列 */
factconst(fsys) ;
break ;
case lparent : /* ( */
factlparent(fsys) ;
break ;
case notsy : /* not */
factnot(fsys) ;
break ;
case lbrack : /* [ 集合の始まり記号 */
factset(fsys) ;
break ;
case nilsy : /* nil */
factnil() ;
break ;
}
if(! inset(fsys,sy)) {
pcerr(6,"") ; /* 不当な記号が現れた */
skip(ws) ; /* fsys+factbegsysまで読み飛ばし*/
}
}
}
/**************************************/
/* factident() : 名前因子の処理 */
/**************************************/
static void factident(Set fsys)
{
ctp *lcp ;
Set ws ;
mkset(&ws, konst,vars,field,func,-1) ; /* 名前を、定数・変数・フィールド・ */
lcp = searchid(ws) ; /* 関数の中から探す */
insymbol() ;
if(lcp->klass == func) {
call(fsys,lcp) ; /* 関数の時、関数呼び出し */
gattr.kind = expr ;
if(gattr.typtr)
if(gattr.typtr->form == subrange) /* 範囲型の時 */
gattr.typtr = gattr.typtr->sf.su.rangetype ; /* 基の型 */
}
else if(lcp->klass == konst) { /* 定数の時 */
gattr.typtr = lcp->idtype ;
gattr.kind = cst ;
gattr.cval = lcp->n.values ; /* 値を入れる */
}
else { /* 変数、レコードフィールドの時*/
selector(fsys,lcp) ; /* 属性選択 */
if(gattr.typtr)
if(gattr.typtr->form == subrange) /* 範囲型の時 */
gattr.typtr = gattr.typtr->sf.su.rangetype ; /* 基の型 */
}
}
/**************************************/
/* factconst() : 定数因子の処理 */
/**************************************/
static void factconst(Set fsys)
{
stp *lsp,*lsp1 ;
gattr.kind = cst ;
switch(sy) {
case intconst : /* 整数定数 */
gattr.typtr = intptr ;
gattr.cval = val ; /* 値を設定 */
break ;
case realconst : /* 実数定数 */
gattr.typtr = realptr ;
gattr.cval = val ;
break ;
case stringconst : /* 文字列 */
if(lgth == 1) /* 1文字 */
gattr.typtr = charptr ; /* char型とする */
else if(lgth == 0) /* 0文字(エラー) */
gattr.typtr = nil ; /* 型なし */
else { /* 2文字以上ある時 */
lsp = (stp*)Malloc(sizeof(stp)); /* 配列型とする */
lsp->form = arrays ;
lsp->size = lgth*charsize ;
lsp->sf.ar.packed = true ; /* 詰め込み型 */
lsp->sf.ar.aeltype = charptr ; /* 要素の型は文字型 */
lsp1 = (stp*)Malloc(sizeof(stp)) ;/* 添字の型は */
lsp1->form = subrange ; /* 範囲型 */
lsp1->size = intsize ;
lsp1->sf.su.rangetype = intptr ;
lsp1->sf.su.min = 1 ; /* 添字の下限値は1 */
lsp1->sf.su.max = (long)lgth ; /* 添字の上限値は文字列長 */
lsp->sf.ar.inxtype = lsp1 ; /* 添字の型をこの範囲型とする*/
gattr.typtr = lsp ;
}
gattr.cval = val ;
}
insymbol() ;
}
/**************************************/
/* factlparent() : (~)の処理 */
/**************************************/
static void factlparent(Set fsys)
{
Set ws ;
insymbol() ;
ws = fsys ;
addset(ws,rparent) ;
expression(ws) ; /* )が出てくるまで式の処理 */
if(sy == rparent) insymbol() ;
else pcerr(4,"") ; /* ) がない */
}
/**************************************/
/* factnot() : not の処理 */
/**************************************/
static void factnot(Set fsys)
{
insymbol() ;
factor(fsys) ; /* notの次の因子の解析 */
load() ; /* load命令の出力 */
if(gattr.typtr != boolptr) {
pcerr(135,"not") ; /* 論理型でないといけない */
gattr.typtr = nil ; /* 次のエラーをださないためnil*/
}
gen0(iNOT) ; /* not命令の出力 */
}
/**************************************/
/* factset() : 集合の処理 */
/**************************************/
static void factset(Set fsys)
{
stp *lsp ;
csp *lvp ;
Set csetpart ;
boolean varpart ; /* 変数要素がある時 true */
boolean cstpart ; /* 定数要素がある時 true */
boolean test ;
Set ws ;
insymbol() ;
mkset(&csetpart,-1) ; /* 固定要素集合のクリア */
varpart = false ;
cstpart = false ;
lsp = (stp*)Malloc(sizeof(stp)) ; /* 集合の型を作成 */
lsp->form = power ;
lsp->size = setsize ;
lsp->assignflag = true ;
lsp->sf.pw.packed = both ;
lsp->sf.pw.elset = nil ;
lsp->sf.pw.elmin = setlow ;
lsp->sf.pw.elmax = sethigh ;
if(sy == rbrack) { /* 空集合の時 */
gattr.typtr = lsp ;
gattr.kind = cst ;
insymbol() ;
}
else { /* 要素がある時 */
do {
mkset(&ws,comma,rbrack,period2,-1);
orset(&ws,&fsys) ;
expression(ws) ; /* 要素 */
if(gattr.typtr)
if((gattr.typtr->form != scalar)/* 要素が順序型かチェック */
|| (gattr.typtr == realptr)) {
pcerr(136,"") ; /* 要素記述は順序型のこと */
gattr.typtr = nil ;
}
else {
if(!lsp->sf.pw.elset) /* 集合の型がない時 */
lsp->sf.pw.elset = gattr.typtr ;/* 要素の型を集合の型とする */
if(compatible(lsp->sf.pw.elset,gattr.typtr)){ /* 要素の型 */
if(sy == period2) factset2(fsys,lsp,&varpart) ; /* .. の処理*/
else { /* 通常の集合要素の処理 */
if(gattr.kind == cst) /* 要素が定数 */
if((gattr.cval.ival < (long)lsp->sf.pw.elmin) || /* 集合の*/
(gattr.cval.ival > (long)lsp->sf.pw.elmax)) /* 範囲 */
pcerr(607,inttoch((long)lsp->sf.pw.elmax)) ;/* 範囲内にない*/
else {
addset(csetpart,gattr.cval.ival) ;/* 定数の集合に加える */
cstpart = true ;
}
else { /* 要素が変数の時 */
load() ; /* 要素値をload */
convertint(gattr.typtr) ; /* 必要ならord命令生成 */
if(debug)
genchk(intptr,111, /* 式がHAPPyの集合範囲に入るか*/
(long)lsp->sf.pw.elmin,(long)lsp->sf.pw.elmax) ;
/* 集合要素の範囲チェック */
gen0(iSGS) ; /* sgs命令(要素1個の集合作成) */
if(varpart) gen0(iUNI) ; /* uni命令(変数の集合に加える)*/
else varpart = true ; /* 初めて変数が現れた時 trueに*/
}
}
}
else pcerr(137,"") ; /* 集合の要素の型が不一致 */
}
if(test=(sy==comma)) insymbol(); /* , なら次の要素を読む */
} while(test) ; /* , ならば次の要素の処理 */
if(sy == rbrack) insymbol() ; /* ] ならば次のsymbolを読む */
else pcerr(12,"") ; /* ] がない */
gattr.typtr = lsp ; /* 集合の型を入れる */
}
lvp = (csp*)Malloc(sizeof(csp)) ; /* 集合定数のエリア確保 */
lvp->cclass = pset ;
lvp->c.pval = csetpart ;
gattr.cval.valp = lvp ;
if(varpart) { /* 変数の要素があった時 */
if(cstpart) { /* 定数要素があった時 */
genldc('s',(long)nil) ; /* ldcs命令 */
gen0(iUNI) ; /* uni命令 */
gattr.kind = expr ;
}
}
}
/****************************************/
/* factset2() : 集合の 範囲要素の処理 */
/* 順序式..順序式 */
/****************************************/
static void factset2(Set fsys,stp *fsp,boolean *varpart)
{
attr lattr ;
Set ws ;
if(gattr.kind == cst) /* 要素が定数 */
if((gattr.cval.ival < (long)fsp->sf.pw.elmin) ||/* 要素の範囲 */
(gattr.cval.ival > (long)fsp->sf.pw.elmax)) /* チェック */
pcerr(607,inttoch((long)fsp->sf.pw.elmax)) ;/* 範囲内にない */
lattr = gattr ;
load() ; /* 要素をload */
convertint(gattr.typtr) ; /* 必要ならord命令生成 */
if(debug)
genchk(intptr,111,(long)fsp->sf.pw.elmin,(long)fsp->sf.pw.elmax) ;
insymbol() ; /* 次の要素を読む */
mkset(&ws,comma,rbrack,-1);
orset(&ws,&fsys);
expression(ws) ; /* 次の要素の処理 */
if(gattr.typtr) {
if(compatible(gattr.typtr,lattr.typtr)) {/* 前の要素との型チェック*/
if(gattr.kind == cst) /* 上限値が定数 */
if((gattr.cval.ival < (long)fsp->sf.pw.elmin) || /* 要素の範囲*/
(gattr.cval.ival > (long)fsp->sf.pw.elmax)) /* チェック */
pcerr(607,inttoch((long)fsp->sf.pw.elmax)) ;/* 範囲内にない */
load() ; /* 要素をload */
convertint(gattr.typtr) ; /* 必要ならord命令生成 */
if(debug)
genchk(intptr,111,(long)fsp->sf.pw.elmin,(long)fsp->sf.pw.elmax) ;
gen0(iMMS) ; /* mms命令生成 */
if(*varpart) gen0(iUNI) ; /* uni命令(変数の集合に加える)*/
else *varpart = true ;
}
else pcerr(137,"") ; /* 集合の要素の型が不一致 */
}
}
/**************************************/
/* factnil() : nil の処理 */
/**************************************/
static void factnil(void)
{
gattr.typtr = nilptr ; /* nil 型 */
gattr.kind = cst ;
gattr.cval.ival = 0 ;
insymbol() ;
}
/**************************************/
/* term() : 式の項(term)の処理 */
/**************************************/
static void term(Set fsys)
{
attr lattr ; /* 1つ前の項の属性 */
enum operator lop ; /* 1つ前の演算子 */
Set ws ;
ws = fsys ;
addset(ws,mulop) ;
factor(ws) ; /* 因子の処理 */
while(sy == mulop) { /* * / div mod and の時 */
load() ; /* 今の項をload */
lattr = gattr ; /* 今の項の属性を退避 */
lop = op ; /* 今の演算子を退避 */
insymbol() ;
factor(ws) ; /* 次の項の処理 */
load() ; /* その項をload */
if((lattr.typtr) && (gattr.typtr))
switch(lop) { /* 演算子で振り分ける */
case mul : mulope(lattr) ; /* * 演算子処理 */
break ;
case rdiv : rdivope(lattr) ; /* / 演算子処理 */
break ;
case idiv : /* div 演算子 */
case imod : /* mod 演算子 */
if((lattr.typtr == intptr) &&
(gattr.typtr == intptr)) /* div/mod の対象はinteger */
(lop==idiv) ? gen0(iDVI) : gen0(iMOD);/*dvi / mod命令を生成*/
else {
pcerr(134,"") ; /* 演算対象の型に誤り */
gattr.typtr = nil ;
}
break ;
case andop : /* and 演算子 */
if((lattr.typtr == boolptr) &&
(gattr.typtr == boolptr)) /* and の対象はboolean */
gen0(iAND) ; /* and命令を生成 */
else {
pcerr(135,"and") ; /* 論理型でない */
gattr.typtr = nil ;
}
}
else gattr.typtr = nil ;
}
}
/**************************************/
/* mulope() : * 演算子処理 */
/**************************************/
static void mulope(attr fattr)
{
if((fattr.typtr == intptr) && /* * の両端がinteger */
(gattr.typtr == intptr))
gen0(iMPI) ; /* mpi命令の生成 */
else {
cnvfloat(&fattr) ; /* realへの変換処理 */
if((fattr.typtr == realptr) &&
(gattr.typtr == realptr)) /* 両端ともrealになっていれば */
gen0(iMPR) ; /* mpr命令を生成 */
else if((gattr.typtr->form == power) /* 集合型で */
&& compatible(fattr.typtr,gattr.typtr)) { /* 型が適合する */
if(fattr.typtr->sf.pw.packed != both) /* 前の式の詰めあり/なし*/
gattr.typtr->sf.pw.packed = fattr.typtr->sf.pw.packed ;
gen0(iINT) ; /* int命令を生成 */
}
else { /* 型が適合しない */
pcerr(134,"") ; /* 演算対象の型に誤り */
gattr.typtr = nil;
}
}
}
/**************************************/
/* rdivope() : / 演算子処理 */
/**************************************/
static void rdivope(attr fattr)
{
cnvfloat(&fattr) ; /* realへの変換処理 */
cnvfloat(&fattr) ; /* を2回呼ぶ */
if((fattr.typtr == realptr) &&
(gattr.typtr == realptr)) /* 両端ともrealになっていれば */
gen0(iDVR) ; /* dvr命令を生成 */
else {
pcerr(134,"") ; /* 演算対象の型に誤り */
gattr.typtr = nil ;
}
}
/*********************************************/
/* simpleexpression() : 単純式の処理 */
/*********************************************/
static void simpleexpression(Set fsys)
{
boolean sign = false ;
attr lattr ;
enum operator lop ;
Set ws ;
if((op == plus) || (op == minus)){ /* + か - の時 */
sign = (op == minus) ; /* - の時 true */
insymbol() ;
}
ws = fsys ;
addset(ws,addop) ;
term(ws) ; /* 項の処理 */
if(sign) { /* - がついていた時 */
load() ;
if(gattr.typtr == intptr)
gen0(iNGI) ; /* ngi 命令の出力 */
else if(gattr.typtr == realptr)
gen0(iNGR) ; /* ngr 命令の出力 */
else {
pcerr(134,"") ; /* 演算対象の型に誤り */
gattr.typtr = nil ; /* 今後のためにnilとする */
}
}
while(sy ==addop) {
load() ;
lattr = gattr ; /* 今の属性を退避 */
lop = op ; /* 今の演算子を退避 */
insymbol() ;
term(ws) ; /* 項の処理 */
load() ;
if((lattr.typtr) && (gattr.typtr))
switch(lop) { /* 前の演算子で振り分ける */
case plus :
case minus : plusminusope(lattr,lop);
break ; /* + - の演算子処理 */
case orop : orope(lattr) ; /* or 演算子処理 */
break ;
}
else gattr.typtr = nil ;
}
}
/**************************************/
/* plusminusope() : + - 演算子処理 */
/**************************************/
static void plusminusope(attr fattr,enum operator fop)
{
if((fattr.typtr == intptr) && /* 前と今の式が両方ともinteger*/
(gattr.typtr == intptr)) /* であれば */
(fop == plus) ? gen0(iADI) : gen0(iSBI) ; /* adi/sbi命令を生成 */
else {
cnvfloat(&fattr) ; /* realに変換 */
if((fattr.typtr == realptr) && /* 前と今の式が両方ともreal */
(gattr.typtr == realptr)) /* になっていれば */
(fop == plus) ? gen0(iADR) : gen0(iSBR) ; /* adr/sbr命令を生成 */
else if((fattr.typtr->form == power) /* 前の式が集合型で */
&& compatible(fattr.typtr,gattr.typtr)){/* 基底の型が同じ */
if(fattr.typtr->sf.pw.packed != both) /* 前の式の詰めあり/なし*/
gattr.typtr->sf.pw.packed = fattr.typtr->sf.pw.packed ;
(fop == plus) ? gen0(iUNI) : gen0(iDIF) ; /* uni/dif命令を生成 */
}
else { /* 型が適合しない */
pcerr(134,"") ; /* 演算対象の型に誤り */
gattr.typtr = nil;
}
}
}
/**************************************/
/* orope() : or 演算子処理 */
/**************************************/
static void orope(attr fattr)
{
if((fattr.typtr == boolptr) && /* 前と今の式が両方ともboolean*/
(gattr.typtr == boolptr)) /* であれば */
gen0(iIOR) ; /* ior命令を生成 */
else {
pcerr(135,"or") ; /* 演算対象は論理型でないと駄目*/
gattr.typtr = nil ;
}
}